perm filename NEW.FAI[XX,LCS]8 blob
sn#249615 filedate 1976-11-29 generic text, type T, neo UTF8
00100 TITLE BMSTF ;0300 SUBROUTINE BMSTF
00200 ENTRY BMSTF
00300 EXTERNAL RHORZ,AMOD,NOZERO,LINES,BMS,MAKNUM
00400 EXTERNAL .COMM.,ALF,POSI,STF,MIN,BM,PLTR,DL
00500 BMSTF: 0 ;00400 IMPLICIT INTEGER(A-Q,S-Z)
00600 ;00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00700 ;00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00800 ;00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00900 ;00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
01000 ;00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01100 ;01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01200 ;01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01300 ;01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400 ;01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1
01500 ;01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,R
01600 ;01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700 ;01600 C RDBR IS SPACER FOR DBL BAR.
01800 ; 02000 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
01900 BS100: MOVE 13,.COMM.+4 ; 02200 R3Q=R3
02000 MOVE 12,STF+=8 ;2400 C NEXT IS FOR BEAMS
02100 MOVEM 12,MIN+1 ;2500 RMINI=RSTJ2
02200 FMPR 12,[16.092] ;12 IS RX RX=2.7*RSTJ2*5.96
02300 SETZM JRVRS#
02400 MOVE 10,.COMM.+=31 ; 10 IS J10, 13 IS R3Q
02500 JUMPE 10,BS101
02600 CAIGE 10,=10 ;IF(J10.GE.10)IT HAS REVERSED STEM INFO.
02700 JRST BS101
02800 MOVE 2,10 ;JRVRS=J10/10
02900 IDIVI 2,=10 ;1=LENGTHEN LEFT SIDE, 2=RIGHT, 3=BOTH
03000 MOVEM 2,JRVRS
03100 MOVEM 3,.COMM.+=31 ;J10
03200 MOVE 10,3 ;AC10 NOW HAS ONLY 2ND DIGIT OF J10
03300 FLTR 3,3 ;VERT DISPLACEMENT MUST BE LESS THAN 10
03400 MOVEM 3,.COMM.+=11 ;R10
03500 ;;; MOVEM 12,RVRS# ;SAVE SIZE OF HORIZ. DISPLACEMENT FOR LATER
03600 BS101: MOVE 5,.COMM.+=10 ; SAVE R9 IN 5
03700 MOVE 6,.COMM.+=28 ; 6 IS J7
03800 MOVE 14,.COMM.+=29 ; J8
03900 ;; MOVE .COMM.+5 ;IF(R4.GE.80)R4=R4-100
04000 ;; CAMGE [-20.0] ;CHECK FOR -95, ETC.
04100 ;; FADR [100.0]
04200 ;; CAMGE [80.0] ;CATCHES SOME NEG. MINIS (I.E.<-100)
04300 ;; JRST .+3
04400 ;; FSBR [100.0]
04500 ;; MOVEM .COMM.+5 ;**** ALL DONE IN CENTX NOW (LOOP.FAI)****
04600 JSA 16,RHORZ ; 02800 R6=RHORZ(R6)
04700 JUMP .COMM.+7
04800 MOVEM 00,.COMM.+7
04900 ;*** MOVSI 2,204500 ; (10.0) IF(R8.NE.0)GO TO 204
05000 ;*** SKIPN .COMM.+=9
05100 ;*** CAMG 2,.COMM.+=11
05200 ;*** JRST BS204 ; IF(R10.GE.10)GO TO 204
05300 ;; JUMPE 5,BSJ8 ; IF(J9.EQ.0)GO TO BSJ8 *** NEW***
05400 JUMPGE 14,BSJ8 ; IF(J8.GE.0)GO TO BSJ8 ***NEW***
05500 JUMPE 5,BS91
05600 ;; JUMPE 5,BS91+2
05700 MOVN 10,14
05800 ;; SETZM .COMM.+=9 ;R8=0
05900 BSJ8: JUMPL 6,BS204 ; 03100 IF(J7)GO TO 204
06000 SKIPN 10 ;IF(J10.NOW IS NE.0)GO TO 204
06100 JUMPG 5,BS1 ; 03200 IF(R9.GT.0)GO TO 1
06200 ; R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
06300 BS204: JUMPE 5,BSR9 ;03400 204 IF(R9.NE.0)R9=RHORZ(R9)
06400 BSX9: JSA 16,RHORZ
06500 JUMP .COMM.+=10
06600 MOVEM 5 ; 5 IS R9
06700 BSR9: JUMPL 6,BS201 ; IF(J7)GO TO 201
06800 ;***BS200: CAIGE 10,=10 ; 200 IF(J10.LT.10)GO TO 91
06900 ;*** JRST BS91
07000 ;; JUMPE 10,BS91 ;IF(J10.EQ.0)GO TO 91 NEXT FOR INNER, PARTIAL BEAMS
07100 ;; CAME 14,[-1]
07200 ;; JRST BSX8 ;IF(R8.EQ.-1)R8=R3 ***NEW***
07300 ;; MOVEM 13,.COMM.+=9
07400 ;; JRST BSR8
07500 JUMPE 14,BS1 ;IF(J8.EQ.0)GO TO 1
07600 JUMPLE 14,BSR8 ;IF(J8.LE.0)GO TO BSR8
07700 BSX8: JSA 16,RHORZ ; 03800 R8=RHORZ(R8)
07800 JUMP .COMM.+=9
07900 MOVEM 00,.COMM.+=9
08000 ;*** JSA 16,AMOD ; 03900 R10=AMOD(R10,10.)
08100 ;*** JUMP .COMM.+=11
08200 ;*** JUMP [10.0]
08300 ;*** MOVEM 00,.COMM.+=11
08400 BSR8: MOVE 02,10 ;J10/10 =0 OR 1 OR 2
08500 IDIVI 02,12
08600 FLTR 3,3
08700 MOVEM 3,.COMM.+=11 ;R10 NOW = DISPLACEMENT
08800 ;*** CAIN 2,3
08900 ;*** JRST BS4
09000 JUMPN 2,.+3
09100 ADDI 10,12 ;J10=J10+10 CHANGES 1 TO 11, ETC.
09200 JRST BS4
09300 CAIN 2,2
09400 JRST BS3 ;4100 2 RH=R9+RX
09500 BS2: MOVE 02,12
09600 FADR 02,5
09700 MOVEM 02,RH#
09800 JRST BS1
09900 BS3: MOVN 02,12 ;4300 3 R8=R9-RX
10000 FADR 02,5
10100 MOVEM 02,.COMM.+=9;10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8
10200 BS4: MOVE 02,.COMM.+=9 ;4500 4 RH=R8
10300 MOVEM 02,RH ;4600 C LEFT INNER POS.
10400 JRST BS1
10500 BS201: MOVNS 6 ;4800 201 J7=-J7
10600 ;4900 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
10700 FLTR 0,10 ;5000 CALL NOZERO(R10)
10800 SKIPN
10900 MOVE [1.0] ;ALWAYS AT LEAST 1 IN DISPLACEMENT (AC.0)
11000 ;*** JSA 16,NOZERO
11100 ;*** JUMP .COMM.+=11
11200 MOVEI 10,36 ;05200 J10=30
11300 ; TO ACTIVATE PARTIAL BEAM SECTION
11400 MOVE 02,.COMM.+=30 ;5400 IF(J9.NE.0)GO TO 202
11500 JUMPG 02,BS202 ;5500 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
11600 MOVSI 02,576400 ;5600 RH=-1
11700 CAIL 6,24 ;5700 IF(J7.GE.20)RH=-RH
11800 MOVNS 2
11900 MOVEM 02,RH
12000 FADR 02,.COMM.+5 ;6000 R5=R4+RH
12100 MOVEM 02,.COMM.+6
12200 MOVE 05,.COMM.+4 ;6100 R9=R3
12300 MOVSI 02,205540 ;6200 R6=R3+22.*RMINI
12400 FMPR 02,MIN+1
12500 FADR 02,.COMM.+4
12600 MOVEM 02,.COMM.+7
12700 BS202: MOVE 12,.COMM.+=9 ;6300 202 IF(R8.EQ.0)R8=4.
12800 JUMPN 12,.+3
12900 MOVSI 12,203400
13000 MOVEM 12,.COMM.+=9
13100 FMPR 12,MIN+1 ;6400 RX=R8*RMINI*2.98
13200 FMPR 12,[2.98]
13300 MOVE 02,12 ; 06500 RH=R9+RX
13400 FADR 02,5
13500 MOVEM 02,RH
13600 MOVN 02,12 ;6600 R9=R9-RX
13700 FADRM 02,5
13800 JRST BS1 ;6700 GO TO 1
13900 ;;BS91: JUMPE 14,BS1 ; 91 IF(J8.EQ.0)GO TO 1
14000 ;; JUMPG 14,BS92 ; IF(J8.GT.0)GO TO 92
14100 ; FOR J8=-(10+DN) OR -(20+DN) R9=R3+RX
14200 BS91: MOVE 5,.COMM.+4
14300 FADR 5,12 ; IF(J8.LE.-20)R9=R6-RX
14400 CAMLE 14,[-=20]
14500 JRST .+3
14600 MOVN 5,12
14700 FADR 5,.COMM.+7
14800 BS192: MOVNS 14 ;7400 192 J8=-J8
14900 BS92: JUMPN 10,.+3 ;92 IF(J10.EQ.0)J10=MOD(J8,10)
15000 MOVE 7,14
15100 IDIVI 7,=10 ; IF(J10.EQ.0)J10=1
15200 SKIPN 10
15300 MOVEI 10,1
15400 FLTR 2,10 ;MOVE 2,10 ; R10=J10
15500 MOVEM 2,.COMM.+=11 ;IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
15600 BS1: MOVM .COMM.+=25 ; 08000 1 IF(IABS(J4).LT.100)GO TO 97
15700 CAIGE 00,=80
15800 JRST BS97
15900 MOVE 02,[0.6] ; 08100 RMINI=.6*RSTJ2
16000 FMPR 02,STF+=8
16100 MOVEM 02,MIN+1
16200 ;; JSA 16,AMOD ;8200 R5=AMOD(R5,100.0)
16300 ;; JUMP .COMM.+6
16400 ;; JUMP [100.0]
16500 ;; MOVEM 00,.COMM.+6 ; SPACE BETWEEN BEAMS
16600 BS97: MOVSI 2,204540 ;8400 97 RJ=RMINI*11.
16700 FMPR 2,MIN+1
16800 MOVEM 2,ALF+=11
16900 MOVSI 206600 ;MOVE [48.0] ;RW=RMINI*RHGT
17000 FMPR MIN+1
17100 MOVEM ALF+=9 ; DIST. UP OR DOWN FROM NOTE HEAD.
17200 FMPR 2,.COMM.+=11 ;RJA=R10*RJ
17300 MOVEM 2,ALF+=14 ; DISPLACEMENT
17400 MOVEM 5,.COMM.+=10 ; RD=R9
17500 MOVEM 5,ALF+7 ; POSITION 3
17600 FSBR 2,ALF+=9
17700 FADR 02,.COMM.+2 ; RJX=CENTR-RW+RJA
17800 MOVEM 02,ALF+=10 ; FINAL HEIGHT OF LEFT SIDE
17900 ; 09300 C NEG R7=TREMOLO
18000 MOVE 11,6
18100 IDIVI 11,=10 ; 09400 RX=MOD(J7,10)
18200 FLTR 12,12 ;FLOAT
18300 MOVEI 1,(6) ; PUT J7 IN 1 FOR NOW
18400 SUBI 6,=20 ;9500 JJ2=J7-20
18500 MOVE 02,.COMM.+7 ; 09600 RA=R6
18600 MOVEM 02,BM ; HORIZANTAL DIST.
18700 MOVSI 3,203700 ; 7.0 RJY=R5*RST7+POS-RST18-RW+RJA
18800 FMPR 03,.COMM.+6
18900 FSBR 3,[18.0]
19000 FMPR 3,STF+=8
19100 FADR 3,ALF+=14
19200 FADR 3,POSI+=9
19300 FSBR 3,ALF+=9
19400 MOVEM 3,BM+2 ; VERTICAL POS OF RIGHT SIDE.
19500 MOVE 4,[14.54] ;10000 RW=R14*RMINI
19600 FMPR 4,MIN+1
19700 MOVEM 4,ALF+=9
19800 MOVSI 0,202400 ;2.0 10100 RY=1./(RHT*RSTJ2)
19900 MOVSI 02,201400 ;*****************8/76
20000 CAMG 0,DL ;IF(RSIZ.GE.2)RY=2./ ....
20100 MOVE 2,0
20200 FDVR 2,DL ;/RSIZ
20300 FDVR 2,STF+=8 ;/RSTJ2
20400 MOVEM 02,RY#
20500 CAIL 1,24 ;200 IF(J7.GE.20)GO TO 98
20600 JRST BS98 ; JUMP IF STEMS ARE DOWN
20700 MOVNS 00,RY ; 10400 RY=-RY
20800 ; 10500 C FOR THICKENING INCR.
20900 ADDI 6,=10 ;0600 JJ2=J7-10
21000 MOVNS 00,ALF+=11 ; 10700 RJ=-RJ
21100 MOVE 02,[96.0] ; 10800 RJA=RMINI*R2HGT-2.*RJA
21200 FMPR 02,MIN+1
21300 MOVE 03,ALF+=14
21400 FSC 03,1
21500 FSBR 02,3
21600 MOVEM 02,ALF+=14
21700 FADRM 02,ALF+=10 ; 10900 RJX=RJX+RJA
21800 FADRM 02,BM+2 ; 11000 RJY=RJY+RJA
21900 FADRM 4,13 ; POSITION 1 11100 R3Q=R3Q+RW
22000 FADRM 4,BM ; POSITION 2 11300 RA=RA+RW
22100 FADRM 4,ALF+7 ; 11500 RD=RD+RW
22200 FADRM 4,RH ; 11700 RH=RH+RW
22300 BS98: MOVE 02,[0.83] ; 11800 98 RSTJ2=RSTJ2*RBM
22400 FMPRM 02,STF+=8
22500 ; RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
22600 MOVEM 6,POSI+=8 ; JJ2 12000 93 IF(JJ2.GT.RX)GO TO 94
22700 FLTR 6,6 ;FLOAT 6
22800 SKIPN 2,JRVRS ;IF(JRVRS.NE.0)DO NEXT
22900 JRST BSZ9
23000 MOVE ALF+=9 ;HORIZ. SIZE OF A NOTE
23100 CAIGE 1,=20 ;CHECK ON STEM DIR. OF BEAM (J7 IS AC1)
23200 MOVNS ;DISPL=-DISPL IF TO LEFT
23300 CAIN 2,3
23400 JRST .+3
23500 CAIE 2,1 ;1 PUSH LEFT, 2 PUSH RIGHT, 3=BOTH
23600 JRST BSY9
23700 FADR 13, ;RQ3=RQ3+NT SZ (DISPL)
23800 CAIN 2,1 ;IF 3, THEN DO NEXT ALSO
23900 JRST BSZ9
24000 MOVNS
24100 ;;BSY9: MOVE 2,RVRS
24200 BSY9: FADRM BM ;CHANGE RIGHT SIDE OF BEAM POS.
24300 BSZ9: CAMLE 6,12
24400 JRST BS94
24500 CAIL 10,=10 ;2100 IF(J10.GE.10)GO TO 7
24600 JRST BS7
24700 ;XXX JUMPN 10,BS7 ;IF(J10.NE.0)GO TO 7
24800 ; 12200 C**********************
24900 JUMPE 14,BS94 ; IF(J8.EQ.0)GO TO 94
25000 ; 12400 R3=RW
25100 MOVE 02,.COMM.+=30 ;12500 IF(J9.EQ.0)GO TO 292
25200 JUMPE 02,BS292
25300 CAIL 14,24 ; IF(J8.GE.20)GO TO 193
25400 JRST BS193
25500 BS293: MOVE 12,13 ; 12700 293 RX=R3Q-RD
25600 FSBR 12,ALF+7
25700 JRST BS194 ; 12800 GO TO 194
25800 BS7: MOVN 4,13 ; 12900 7 RHX=RH-R3Q
25900 FADR 4,ALF+7 ; 13000 R3=RD-R3Q
26000 JRST BS292 ; 13100 GO TO 292
26100 BS193: MOVE 12,ALF+7 ; 13200 193 RX=RD-RA
26200 FSBR 12,BM ; 13300 194 R3=ABS(RX)
26300 BS194: MOVM 4,12 ; 13400 292 DISX=ABS(R3Q-RA)
26400 BS292: MOVE 02,13
26500 FSBR 02,BM
26600 MOVMM 02,ALF+=16 ;13500 HGT=RJX-RJY
26700 MOVE 3,ALF+=10
26800 FSBR 3,BM+2
26900 MOVEM 3,HGT#
27000 CAIGE 10,=10 ;3600 IF(J10.GE.10)HGT1=HGT*RHX/DISX
27100 JRST BS10
27200 ;XXX JUMPE 10,BS10 ;IF(J10.EQ.0)GO TO 10
27300 MOVN 1,13
27400 FADR 1,RH
27500 FMPR 1,3
27600 FDVR 1,2 ; 1 HAS -HGT1
27700 BS10: FDVR 4,ALF+=16 ;13800 R3=R3/DISX
27800 MOVEM 4,.COMM.+4 ;13900 195 HGT=HGT*R3
27900 FMPRB 4,HGT ; 14000 196 L=J8/10
28000 SETZM .COMM.+=29 ; 14100 J8=0
28100 CAIL 10,=10 ;14200 IF(J10.GE.10)GO TO 8
28200 JRST BS8
28300 ;XXX JUMPN 10,BS8 ;IF(J10.NE.0)GO TO 8
28400 IDIVI 14,=10 ;( L=J8/10)
28500 CAIN 14,1 ; IF(L.EQ.1)GO TO 95
28600 JRST BS95 ;BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
28700 ; 14600 R3Q=RD
28800 MOVE 13,ALF+7 ; 14700 RJX=RJY+HGT
28900 FADR 04,BM+2 ; 4 WAS HGT
29000 MOVEM 04,ALF+=10 ; 14800 GO TO 94
29100 JRST BS94 ; 15000 8 R3Q=RH
29200 BS8: MOVE 13,RH ;15200 RJY=RJX-HGT
29300 MOVE 02,ALF+=10
29400 FSBR 02,HGT
29500 MOVEM 02,BM+2
29600 FADRM 1,ALF+=10 ;15300 RJX=RJX-HGT1
29700 ; 15400 GO TO 94
29800 JRST BS94-2 ; 15500 95 RA=RD
29900 ; 15600 RJY=RJX-HGT
30000 BS95: MOVE 02,ALF+=10
30100 FSBR 02,HGT
30200 MOVEM 02,BM+2
30300 MOVE 02,ALF+7
30400 MOVEM 02,BM
30500 BS94: MOVEM 13,ALF+5 ;(R3Q)15700 94 L=7.*RMINI
30600 MOVE 13,PLTR ; AC13 SHOULD NOT BE TAMPERED WITH!
30700 JUMPGE 13,BS930 ;IF(PLT.GE.0)GO TO 930 (SKIP FOR DPY)
30800 MOVSI 02,203740 ; WAS 7.0 (203700)
30900 FMPR 2,MIN+1 ;7.5*RMINI*RSIZ (DL)
31000 FMPR 2,DL ;MAKES CORRECT THICKNESS ON PLOTTER.
31100 KIFIX 0,2 ;JSA 16,IFIX
31200 MOVSI 2,202400 ;IF(RSIZ.GE.2.0)L=L/2 HALF AS MANY LINES.
31300 CAMG 2,DL
31400 IDIVI 0,2 ;********** 8/76
31500 MOVEM 00,ALF+=12 ;15800 930 RC=0
31600 BS930: SETZM BM+1
31700 ; C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
31800 JSA 16,LINES ;16000 CALL LINES(R3Q,RJX,3)
31900 JUMP ALF+5
32000 JUMP ALF+=10
32100 JUMP [3] ;16100 DO 941 K=1,L
32200 MOVEI 15,1 ; 16200 CALL BMS
32300 BS12: JSA 16,BMS ;16300 IF(PLT.GE.0)GO TO 940
32400 JUMPGE 13,BS940 ; 16400 RC=RC+RY
32500 MOVE 02,RY
32600 FADRM 02,BM+1 ; FOR THICKENING.
32700 JSA 16,BMS ;16600 CALL BMS
32800 MOVE 1,ALF+5 ; CALL EXCH(RA,ALF+5)
32900 EXCH 1,BM
33000 MOVEM 1,ALF+5
33100 MOVE 1,ALF+=10
33200 EXCH 1,BM+2 ; 941 CALL EXCH(RJY,RJX)
33300 MOVEM 1,ALF+=10
33400 CAMGE 15,ALF+=12
33500 AOJA 15,BS12 ; 16900 CALL BMS
33600 JSA 16,BMS ; DRAWS 5 LINES FOR BEAMS.
33700 ; 17100 940 JJ2=JJ2-1
33800 BS940: SOSG POSI+=8 ; 17200 IF(JJ2.LE.0)GO TO 942
33900 JRST BS942 ; IF P7=10 OR 20 ONE BEAM WILL APPEAR.
34000 ; 17400 RJY=RJY+RJ
34100 MOVE 02,ALF+=11
34200 FADRM 02,BM+2 ; 17500 RJX=RJX+RJ
34300 FADRM 02,ALF+=10
34400 JRST BS930 ;17600 GO TO 930
34500 BS942: SKIPN 14 ;17800 942 IF(J8.NE.0)RETURN
34600 SKIPG .COMM.+=30
34700 JRA 16,(16) ;17900 IF(J9.LE.0)RETURN
34800 MOVSI 02,205740 ;18000 IF(R10.GE.30)RETURN
34900 SKIPL .COMM.+=28 ;IF(J7.LT.0)RETURN
35000 CAMG 02,.COMM.+=11
35100 JRA 16,(16) ; C FOR NUMBERS OUTSIDE BEAMS
35200 MOVE 02,MIN+1 ;18200 RSTJ2=RMINI
35300 MOVEM 02,STF+=8
35400 MOVN 3,[10.0] ;18300 RD=-10.
35500 MOVSI 02,205500 ;18400 IF(R7.LT.20)RD=8.3
35600 CAMLE 02,.COMM.+=8
35700 MOVE 3,[8.3]
35800 BS943: MOVN 02,ALF+5 ;18500 943 J3=R3Q+(RA-R3Q)/2.
35900 FADR 02,BM
36000 FSC 02,777777
36100 FADR 02,ALF+5
36200 KIFIX 0,2 ;FIX IT
36300 MOVEM 00,.COMM.+=24 ;18600 R6=1.
36400 MOVSI 02,201400
36500 MOVEM 02,.COMM.+7 ;18900 R7=1
36600 MOVEM 02,.COMM.+=8 ; C ITALICS
36700 ; 18800 R4=R4+(R5-R4)/2.+RD
36800 MOVE 02,.COMM.+6
36900 FSBR 02,.COMM.+5
37000 FSC 02,777777
37100 FADR 2,3
37200 FADRM 02,.COMM.+5 ↔ SETZM .COMM.+=12 ; R11=0
37300 ; 19100 CALL MAKNUM(R9)
37400 JSA 16,MAKNUM
37500 JUMP .COMM.+=10
37600 JRA 16,(16) ; 19300 END
37700 END